home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / prlgbnch.lha / meta_qsort.pl < prev    next >
Text File  |  1990-05-25  |  3KB  |  104 lines
  1. % generated: 8 March 1990
  2. % option(s): 
  3. %
  4. %   meta_qsort
  5. %
  6. %   Ralph M. Haygood
  7. %
  8. %   meta-interpret Warren benchmark qsort
  9.  
  10. /* For any meta-variable ~X~, interpret(~X~) behaves as if
  11.    
  12.    interpret(~X~) :- ~X~.
  13.    
  14.    Thus, for example, interpret((foo(X), bar(X), !)) behaves as if
  15.    
  16.    interpret((foo(X), bar(X), !)) :- foo(X), bar(X), !.
  17.    
  18.    Note that though ~X~ may contain cuts, those cuts cannot escape from
  19.    interpret(~X~) to effect the parent goal; interpret(!) is equivalent
  20.    to true.
  21.    
  22.    Cuts inside ~X~ are executed according to the rule that conjunction,
  23.    disjunction, and if-then-else are transparent to cuts, and any other
  24.    form is transparent to cuts if and only if it can be macro-expanded
  25.    into a form involving only these three without interpret/1.  If-then
  26.    and negation are the only such other forms currently recognized; ( A
  27.    -> B) is equivalent to ( A -> B ; fail ), and \+ A is equivalent to
  28.    ( A -> fail ; true ).
  29. */
  30.  
  31. meta_qsort :- interpret(qsort).
  32.  
  33. interpret(Goal) :-
  34.     interpret(Goal, Rest),
  35.     ( nonvar(Rest), !,
  36.       interpret(Rest) 
  37.     ; true 
  38.     ).
  39.  
  40. interpret(G, _) :-
  41.     var(G), !,
  42.     fail.
  43. interpret((A, B), Rest) :- !,
  44.     interpret(A, Rest0),
  45.     ( nonvar(Rest0) ->
  46.         Rest = (Rest0, B)
  47.     ; interpret(B, Rest)
  48.     ).
  49. interpret((A ; B), Rest) :- !,
  50.     interpret_disjunction(A, B, Rest).
  51. interpret((A -> B), Rest) :- !,
  52.     interpret_disjunction((A -> B), fail, Rest).
  53. interpret(\+A, Rest) :- !,
  54.     interpret_disjunction((A -> fail), true, Rest).
  55. interpret(!, true) :- !.
  56. interpret(G, _) :-
  57.     number(G), !,
  58.     fail.
  59. interpret(G, _) :-
  60.     is_built_in(G), !,
  61.     interpret_built_in(G).
  62. interpret(G, _) :-
  63.     define(G, Body),
  64.     interpret(Body).
  65.  
  66. interpret_disjunction((A -> B), _, Rest) :-
  67.     interpret(A, Rest0), !,
  68.     ( nonvar(Rest0) ->
  69.         Rest = (Rest0 -> B)
  70.     ; interpret(B, Rest)
  71.     ).
  72. interpret_disjunction((_ -> _), C, Rest) :- !,
  73.     interpret(C, Rest).
  74. interpret_disjunction(A, _, Rest) :-
  75.     interpret(A, Rest).
  76. interpret_disjunction(_, B, Rest) :-
  77.     interpret(B, Rest).
  78.  
  79. is_built_in(true).
  80. is_built_in(_=<_).
  81.  
  82. interpret_built_in(true).
  83. interpret_built_in(X=<Y) :- X =< Y.
  84.  
  85. define(qsort,(
  86.        qsort([27,74,17,33,94,18,46,83,65, 2,
  87.               32,53,28,85,99,47,28,82, 6,11,
  88.               55,29,39,81,90,37,10, 0,66,51,
  89.                7,21,85,27,31,63,75, 4,95,99,
  90.               11,28,61,74,18,92,40,53,59, 8],_,[]))).
  91.  
  92. define(qsort([X|L],R,R0),(
  93.        partition(L,X,L1,L2),
  94.        qsort(L2,R1,R0),
  95.        qsort(L1,R,[X|R1]))).
  96. define(qsort([],R,R),true).
  97.  
  98. define(partition([X|L],Y,[X|L1],L2),(
  99.        X=<Y,!,
  100.        partition(L,Y,L1,L2))).
  101. define(partition([X|L],Y,L1,[X|L2]),(
  102.        partition(L,Y,L1,L2))).
  103. define(partition([],_,[],[]),true).
  104.